home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / iconv8_s.arc / ICONX.ARC / RLOCAL.C < prev    next >
Encoding:
C/C++ Source or Header  |  1990-03-28  |  22.0 KB  |  841 lines
  1. /*
  2.  * Routines needed for different systems.
  3.  */
  4.  
  5. #include <math.h>
  6. #include "..\h\config.h"
  7. #include "..\h\rt.h"
  8. #include "rproto.h"
  9. #include <ctype.h>
  10.  
  11. /*
  12.  * The following code is operating-system dependent [@rlocal.01].
  13.  *  Routines needed by different systems.
  14.  */
  15.  
  16. #if PORT
  17.    /* place for anything system-specific */
  18. Deliberate Syntax Error
  19. #endif                    /* PORT */
  20.  
  21. #if AMIGA
  22. #if AZTEC_C
  23. /*
  24.  * abs
  25.  */
  26. abs(i)
  27. int i;
  28. {
  29.     return ((i<0)? (-i) : i);
  30. }
  31.  
  32. /*
  33.  * ldexp
  34.  */
  35. double ldexp(value,exp)
  36. double value;
  37. {
  38.   double retval = 1.0;
  39.   if(exp>0) {
  40.     while(exp-->0) retval *= 2.0;
  41.   } else if (exp<0) {
  42.     while(exp++<0) retval = retval / 2.0;
  43.   }
  44.   return value * retval;
  45. }
  46.  
  47. /*
  48.  *  abort()
  49.  */
  50. novalue abort()
  51. {
  52.   fprintf(stderr,"ICON ERROR WITH ICONCORE SET\n");
  53.   fflush(stderr);
  54.   exit(1);
  55. }
  56.  
  57. #ifdef SystemFnc
  58.  
  59. /*
  60.  * Aztec C version 3.6 does not support system(), but here is a substitute.
  61.  * This is a bonafide untested-original-it-just-compiles routine.
  62.  * Manx will probably implement system() before we fix this version...
  63.  */
  64. #include <ctype.h>
  65.  
  66. #define KLUDGE1 256
  67. #define KLUDGE2 64
  68. int system(s)
  69. char *s;
  70. {
  71.    char text[KLUDGE1], *cp=text;
  72.    char **av[KLUDGE2];
  73.    int ac = 0;
  74.    int l  = strlen(s);
  75.  
  76.    if (l >= KLUDGE1)
  77.       return -1;
  78.    strcpy(text,s);
  79.    av[ac++] = text;
  80.    while(*cp && ac<KLUDGE2-1) {
  81.       if (isspace(*cp)) {
  82.          *cp++ = '\0';
  83.      while(isspace(*cp))
  84.         cp++;
  85.          if (*cp)
  86.         av[ac++] = cp;
  87.          }
  88.       else {
  89.          cp++;
  90.          }
  91.       }
  92.     av[ac] = NULL;
  93.     return fexecv(av[0], av);
  94. }
  95. #endif                    /* SystemFnc */
  96. #endif                    /* AZTEC_C */
  97. #endif                    /* AMIGA */
  98.  
  99. #if ATARI_ST
  100. #if LATTICE
  101.  
  102. long _STACK = 10240;
  103. long _MNEED = 200000;    /* reserve space for allocation (may be too large) */
  104.  
  105. #include <osbind.h>
  106.  
  107. /*  Structure necessary for handling system time. */
  108.    struct tm {
  109.        short tm_year;
  110.        short tm_mon;
  111.        short tm_wday;
  112.        short tm_mday;
  113.        short tm_hour;
  114.        short tm_min;
  115.        short tm_sec;
  116.    };
  117.  
  118. struct tm *localtime(clock)   /* fill structure with clock time */
  119. int clock;     /* millisecond timer value, if supplied; not used */
  120. {
  121.   static struct tm tv;
  122.   unsigned int time, date;
  123.  
  124.   time = Tgettime();
  125.   date = Tgetdate();
  126.   tv.tm_year = ((date >> 9) & 0x7f) + 80;
  127.   tv.tm_mon  = ((date >> 5) & 0xf) - 1;
  128.   tv.tm_mday = date & 0x1f;
  129.   tv.tm_hour = (time >> 11) & 0x1f;
  130.   tv.tm_min  = (time >> 5)  & 0x3f;
  131.   tv.tm_sec  = 2 * (time & 0x1f);
  132.  
  133.   tv.tm_wday = weekday(tv.tm_mday,tv.tm_mon+1,tv.tm_year);
  134.   return(&tv);
  135. }
  136.  
  137.  
  138. weekday(day,month,year)   /* find day of week from    */
  139. short day, month, year;   /* day, month, and year     */
  140. {                         /* Sunday..Saturday is 0..6 */
  141.   int index, yrndx, mondx;
  142.  
  143.   if(month <= 2) {   /* Jan or Feb month adjust */
  144.       month += 12;
  145.       year  -=  1;
  146.   }
  147.  
  148.   yrndx = year + (year / 4) - (year / 100) + (year / 400);
  149.   mondx = 2 * month + (3 * (month + 1)) / 5;
  150.   index = day + mondx + yrndx + 2;
  151.   return(index % 7);
  152. }
  153.  
  154.  
  155.  
  156. time(ptime)   /* return value of millisecond timer */
  157. int  *ptime;
  158. {
  159.   int  tmp, ssp;   /* value of supervisor stack pointer */
  160.   static int  *tmr = (int *) 0x04ba;   /* addr of timer */
  161.  
  162.   ssp = gemdos(0x20,0);   /* enter supervisor mode */
  163.   tmp = *tmr * 5;         /* get millisecond timer */
  164.   ssp = gemdos(0x20,ssp); /* enter programmer mode */
  165.  
  166.   if(ptime != NULL)
  167.       *ptime = tmp;
  168.  
  169.   return(tmp);
  170. }
  171.  
  172. int brk(p)
  173. char *p;
  174. {
  175.   char *sbrk();
  176.   long int l, m;
  177.  
  178.   l = (long int)p;
  179.   m = (long int)sbrk(0);
  180.  
  181.   return((lsbrk((long) (l - m)) == 0) ? -1 : 0);
  182. }
  183.  
  184.  
  185. #ifdef LocalQsort
  186. /* Shell sort with some enhancements from Knuth.. */
  187.  
  188. void qsort( base, nel, width, cmp )   /* was llqsort( ... */
  189. char *base;                           /*-also kqsort( ...-*/
  190. int nel;
  191. int width;
  192. int (*cmp)();
  193. {
  194.    register int i, j;
  195.    long int gap;
  196.    int k, tmp ;
  197.    char *p1, *p2;
  198.  
  199.    for( gap=1; gap <= nel; gap = 3*gap + 1 ) ;
  200.  
  201.    for( gap /= 3;  gap > 0  ; gap /= 3 )
  202.        for( i = gap; i < nel; i++ )
  203.            for( j = i-gap; j >= 0 ; j -= gap ) {
  204.                 p1 = base + ( j     * width);
  205.                 p2 = base + ((j+gap) * width);
  206.  
  207.                 if( (*cmp)( p1, p2 ) <= 0 ) break;
  208.  
  209.                 for( k = width; --k >= 0 ;) {
  210.                    tmp   = *p1;
  211.                    *p1++ = *p2;
  212.                    *p2++ = tmp;
  213.                 }
  214.            }
  215. }
  216. #endif                    /* LocalQsort */
  217.  
  218. #endif                    /* LATTICE */
  219. #endif                    /* ATARI_ST */
  220.  
  221. #if HIGHC_386
  222. #endif                    /* HIGHC_386 */
  223.  
  224. #if MACINTOSH
  225. #if MPW
  226. /*
  227. **  Special routines for Macintosh Programmer's Workshop
  228. **  implementation of the Icon Programming Language
  229. */
  230.  
  231. #include <Types.h>
  232. #include <Events.h>
  233. #include <OSUtils.h>
  234. #define MaxBlockX MaxBlock /* MaxBlock Icon definition conflicts */
  235. #undef MaxBlock           /* with Mac Toolbox routine */
  236. #include <Memory.h>
  237. #define MaxBlock MaxBlockX
  238. #undef MaxBlockX
  239. #include <Errors.h>
  240.  
  241. /*
  242. **  Initialization and Termination Routines
  243. */
  244. /*
  245. **  MacExit -- This function is installed by an onexit() call in MacInit
  246. **  -- it is called automatically when the program terminates.
  247. */
  248. void
  249. MacExit()
  250. {
  251.   void ResetStack();
  252.   extern Ptr MemBlock;
  253.  
  254.   ResetStack();
  255.   if (MemBlock != NULL) DisposPtr(MemBlock);
  256. }
  257.  
  258. /*
  259. **  MacInit -- This function is called near the beginning of execution of
  260. **  iconx.  It is called by our own brk/sbrk initialization routine.
  261. */
  262. void
  263. MacInit()
  264. {
  265.   atexit(MacExit);
  266. }
  267.  
  268.  
  269. /*
  270. **  Brk and Sbrk Equivalents
  271. */
  272.  
  273. typedef Ptr caddr_t;
  274.  
  275. static caddr_t MemBlock, Break, Limit;
  276. word xcodesize;
  277.  
  278. init_brk()
  279. {
  280.   static short init = 0;
  281.   Size max, grow, size;
  282.   char *v;
  283.   extern word mstksize, statsize, ssize, abrsize;
  284.  
  285.   if (!init) {
  286.     init = 1;
  287.     MacInit();
  288.     if ((v = getenv("ICONSIZE")) != NULL) {    /* if ICONSIZE defined */
  289.       if ((size = atol(v)) <= 0) {        /* if ICONSIZE negative */
  290.     max = MaxMem(&grow);
  291.     size = max + grow - (size < 0 ? -size : max / 4);
  292.       }
  293.     }
  294.     else {                    /* if ICONSIZE undefined */
  295.       size = xcodesize + mstksize + statsize + ssize + abrsize + 512;
  296.     }
  297.     if ((MemBlock = NewPtr(size)) == NULL) {
  298.       syserr("problem allocating Mac memory");
  299.     }
  300.     Break = MemBlock;
  301.     Limit = MemBlock + size;
  302.   }
  303.   return 1;
  304. }
  305.  
  306. caddr_t
  307. brk(addr)
  308. caddr_t addr;
  309. {
  310.   Size newsize;
  311.  
  312.   if (!init_brk()) return (caddr_t)-1;
  313.   if (addr < MemBlock) return (caddr_t)-1;
  314.   if (addr < Limit) Break = addr;
  315.   else {
  316.     newsize = addr - MemBlock;
  317.     SetPtrSize(MemBlock, newsize);
  318.     if (MemError() != noErr) return (caddr_t)-1;
  319.     Break = Limit = addr;
  320.   }
  321.   return (caddr_t)0;
  322. }
  323.  
  324. caddr_t
  325. sbrk(incr)
  326. int incr;
  327. {
  328.   caddr_t start;
  329.  
  330.   if (!init_brk()) return (caddr_t)-1;
  331.   start = Break;
  332.   if (incr != 0) {
  333.     if (brk(start + incr) == (caddr_t)-1) return (caddr_t)-1;
  334.   }
  335.   return start;
  336. }
  337.  
  338. #endif                    /* MPW */
  339. #endif                    /* MACINTOSH */
  340.  
  341. #if MSDOS
  342.  
  343. #if TURBO
  344. extern unsigned _stklen = 8 * 1024;
  345. #endif                    /* TURBO */
  346.  
  347. #if LATTICE
  348.  
  349. #include <error.h>
  350.  
  351. int _stack = (8 * 1024);
  352. long int _mneed = (20 * 1024);
  353.  
  354. extern long int *sp;
  355. long int **xsp = &sp;  /* Used for rswitch.asm .. since 'sp' is a reserved */
  356.                /* symbol for the assembler.. */
  357.  
  358. extern char *statend;  /* Indicator for when to use malloc for _GETBF */
  359.  
  360. int brk(p)
  361. char *p;
  362. {
  363.    char *sbrk();
  364.    long int l, m;
  365.  
  366.    l = (long int)p;
  367.    m = (long int)sbrk((word)0);
  368.  
  369.    if( lsbrk((long) (l - m) ) == 0) return -1;
  370.    else return 0;
  371. }
  372.  
  373. novalue abort()    /* Abort set to 'dump' icon data area.. */
  374. {
  375. #ifdef DeBugIconx
  376.    blkdump();
  377. #endif                    /* DeBugIconx */
  378.    fflush(stderr);
  379.    fcloseall();
  380.    _exit(1);
  381. }
  382. #endif                    /* LATTICE */
  383. #endif                    /* MSDOS */
  384.  
  385. #if MVS || VM
  386. #if SASC
  387. #include <options.h>
  388. char _linkage = _OPTIMIZE;
  389.  
  390. #if MVS
  391. char *_style = "tso:";          /* use dsnames as file names */
  392. #define SYS_OSVS
  393. #else                    /* MVS */
  394. #define SYS_CMS
  395. #endif                    /* MVS */
  396. int _mneed = 512000;            /* size of sbrk-managed region */
  397.  
  398. #define RES_SIGNAL
  399. #define RES_COPROC
  400. #define RES_IOUTIL
  401. #define RES_DSNAME
  402. #define RES_FILEDEF
  403. #define RES_UNITREC
  404. #if VM
  405. #define BIMODAL_CMS
  406. #endif                    /* VM */
  407.  
  408. #include <resident.h>
  409.  
  410. #endif                    /* SASC */
  411. #ifdef WATERLOO_C_V3_0
  412. const int _staksize = (64*1024);
  413. #endif                    /* WATERLOO_C_V3_0 */
  414. #endif                    /* MVS || VM */
  415.  
  416. #if OS2
  417. #endif                    /* OS2 */
  418.  
  419. #if UNIX
  420. #ifdef ATTM32
  421.  
  422. /*
  423.  * This file contains the routine necessary to allocate legal AT&T
  424.  * 3B2/15/4000 stack space for co-expression stacks.
  425.  *
  426.  * Legal stack region begins at 0xC0020000, and UNIX will grow stack space
  427.  * up to 50 Megabytes. 0xC0030000 should provide plenty of room for
  428.  * main C stack growth.  Each time coexpr_salloc() is called, it
  429.  * adds mstksize (max main stack size) and returns a new address,
  430.  * meaning each coexpression stack is potentially as large as the main stack.
  431.  */
  432.  
  433. /*
  434.  * coexp_salloc() - return pointer in legal stack space for start
  435.  *                  of a coexpression stack.
  436.  */
  437.  
  438. pointer coexp_salloc()
  439.    {
  440.    static pointer sp = 0xC0030000 ;     /* pointer to stack region */
  441.  
  442.    sp +=  mstksize;
  443.    return sp;
  444. }
  445. #endif                    /* ATTM32 */
  446. #if CONVEX
  447.  
  448. /* replacement pow() that allows negative ** integer */
  449.  
  450. #undef pow
  451.  
  452. double pow0 (base, exp)
  453.     double base, exp;
  454. {   if (base >= 0) return pow (base, exp);
  455.     else {
  456.     long n = exp;
  457.     if (n != exp) runerr (-206, 0);
  458.     else if (n & 1) return -pow (-base, exp);
  459.     else return pow (-base, exp);}}
  460. #endif                    /* CONVEX */
  461.  
  462. #endif                    /* UNIX */
  463.  
  464. #if VMS
  465. #include dvidef
  466. #include iodef
  467.  
  468. typedef struct _descr {
  469.    int length;
  470.    char *ptr;
  471. } descriptor;
  472.  
  473. typedef struct _pipe {
  474.    long pid;            /* process id of child */
  475.    long status;            /* exit status of child */
  476.    long flags;            /* LIB$SPAWN flags */
  477.    int channel;            /* MBX channel number */
  478.    int efn;            /* Event flag to wait for */
  479.    char mode;            /* the open mode */
  480.    FILE *fptr;            /* file pointer (for fun) */
  481.    unsigned running : 1;    /* 1 if child is running */
  482. } Pipe;
  483.  
  484. Pipe _pipes[_NFILE];        /* one for every open file */
  485.  
  486. #define NOWAIT        1
  487. #define NOCLISYM    2
  488. #define NOLOGNAM    4
  489. #define NOKEYPAD    8
  490. #define NOTIFY        16
  491. #define NOCONTROL    32
  492. #define SFLAGS    (NOWAIT|NOKEYPAD|NOCONTROL)
  493.  
  494. /*
  495.  * popen - open a pipe command
  496.  * Last modified 2-Apr-86/chj
  497.  *
  498.  *    popen("command", mode)
  499.  */
  500.  
  501. FILE *popen(cmd, mode)
  502. char *cmd;
  503. char *mode;
  504. {
  505.    FILE *pfile;            /* the Pfile */
  506.    Pipe *pd;            /* _pipe database */
  507.    descriptor mbxname;        /* name of mailbox */
  508.    descriptor command;        /* command string descriptor */
  509.    descriptor nl;        /* null device descriptor */
  510.    char mname[65];        /* mailbox name string */
  511.    int chan;            /* mailbox channel number */
  512.    int status;            /* system service status */
  513.    int efn;
  514.    struct {
  515.       short len;
  516.       short code;
  517.       char *address;
  518.       char *retlen;
  519.       int last;
  520.    } itmlst;
  521.  
  522.    if (!cmd || !mode)
  523.       return (0);
  524.    LIB$GET_EF(&efn);
  525.    if (efn == -1)
  526.       return (0);
  527.    if (_tolower(mode[0]) != 'r' && _tolower(mode[0]) != 'w')
  528.       return (0);
  529.    /* create and open the mailbox */
  530.    status = SYS$CREMBX(0, &chan, 0, 0, 0, 0, 0);
  531.    if (!(status & 1)) {
  532.       LIB$FREE_EF(&efn);
  533.       return (0);
  534.    }
  535.    itmlst.last = mbxname.length = 0;
  536.    itmlst.address = mbxname.ptr = mname;
  537.    itmlst.retlen = &mbxname.length;
  538.    itmlst.code = DVI$_DEVNAM;
  539.    itmlst.len = 64;
  540.    status = SYS$GETDVIW(0, chan, 0, &itmlst, 0, 0, 0, 0);
  541.    if (!(status & 1)) {
  542.       LIB$FREE_EF(&efn);
  543.       return (0);
  544.    }
  545.    mname[mbxname.length] = '\0';
  546.    pfile = fopen(mname, mode);
  547.    if (!pfile) {
  548.       LIB$FREE_EF(&efn);
  549.       SYS$DASSGN(chan);
  550.       return (0);
  551.    }
  552.    /* Save file information now */
  553.    pd = &_pipes[fileno(pfile)];    /* get Pipe pointer */
  554.    pd->mode = _tolower(mode[0]);
  555.    pd->fptr = pfile;
  556.    pd->pid = pd->status = pd->running = 0;
  557.    pd->flags = SFLAGS;
  558.    pd->channel = chan;
  559.    pd->efn = efn;
  560.    /* fork the command */
  561.    nl.length = strlen("_NL:");
  562.    nl.ptr = "_NL:";
  563.    command.length = strlen(cmd);
  564.    command.ptr = cmd;
  565.    status = LIB$SPAWN(&command,
  566.       (pd->mode == 'r') ? 0 : &mbxname,    /* input file */
  567.       (pd->mode == 'r') ? &mbxname : 0,    /* output file */
  568.       &pd->flags, 0, &pd->pid, &pd->status, &pd->efn, 0, 0, 0, 0);
  569.    if (!(status & 1)) {
  570.       LIB$FREE_EF(&efn);
  571.       SYS$DASSGN(chan);
  572.       return (0);
  573.    } else {
  574.       pd->running = 1;
  575.    }
  576.    return (pfile);
  577. }
  578.  
  579. /*
  580.  * pclose - close a pipe
  581.  * Last modified 2-Apr-86/chj
  582.  *
  583.  */
  584. pclose(pfile)
  585. FILE *pfile;
  586. {
  587.    Pipe *pd;
  588.    int status;
  589.    int fstatus;
  590.  
  591.    pd = fileno(pfile) ? &_pipes[fileno(pfile)] : 0;
  592.    if (pd == NULL)
  593.       return (-1);
  594.    fflush(pd->fptr);            /* flush buffers */
  595.    fstatus = fclose(pfile);
  596.    if (pd->mode == 'w') {
  597.       status = SYS$QIOW(0, pd->channel, IO$_WRITEOF, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  598.       SYS$WFLOR(pd->efn, 1 << (pd->efn % 32));
  599.    }
  600.    SYS$DASSGN(pd->channel);
  601.    LIB$FREE_EF(&pd->efn);
  602.    pd->running = 0;
  603.    return (fstatus);
  604. }
  605.  
  606. /*
  607.  * redirect(&argc,argv,nfargs) - redirect standard I/O
  608.  *    int *argc        number of command arguments (from call to main)
  609.  *    char *argv[]    command argument list (from call to main)
  610.  *    int nfargs    number of filename arguments to process
  611.  *
  612.  * argc and argv will be adjusted by redirect.
  613.  *
  614.  * redirect processes a program's command argument list and handles redirection
  615.  * of stdin, and stdout.  Any arguments which redirect I/O are removed from the
  616.  * argument list, and argc is adjusted accordingly.  redirect would typically be
  617.  * called as the first statement in the main program.
  618.  *
  619.  * Files are redirected based on syntax or position of command arguments.
  620.  * Arguments of the following forms always redirect a file:
  621.  *
  622.  *    <file    redirects standard input to read the given file
  623.  *    >file    redirects standard output to write to the given file
  624.  *    >>file    redirects standard output to append to the given file
  625.  *
  626.  * It is often useful to allow alternate input and output files as the
  627.  * first two command arguments without requiring the <file and >file
  628.  * syntax.  If the nfargs argument to redirect is 2 or more then the
  629.  * first two command arguments, if supplied, will be interpreted in this
  630.  * manner:  the first argument replaces stdin and the second stdout.
  631.  * A filename of "-" may be specified to occupy a position without
  632.  * performing any redirection.
  633.  *
  634.  * If nfargs is 1, only the first argument will be considered and will
  635.  * replace standard input if given.  Any arguments processed by setting
  636.  * nfargs > 0 will be removed from the argument list, and again argc will
  637.  * be adjusted.  Positional redirection follows syntax-specified
  638.  * redirection and therefore overrides it.
  639.  *
  640.  */
  641.  
  642.  
  643. redirect(argc,argv,nfargs)
  644. int *argc, nfargs;
  645. char *argv[];
  646. {
  647.    int i;
  648.  
  649.    i = 1;
  650.    while (i < *argc)  {        /* for every command argument... */
  651.       switch (argv[i][0])  {        /* check first character */
  652.          case '<':            /* <file redirects stdin */
  653.             filearg(argc,argv,i,1,stdin,"r");
  654.             break;
  655.          case '>':            /* >file or >>file redirects stdout */
  656.             if (argv[i][1] == '>')
  657.                filearg(argc,argv,i,2,stdout,"a");
  658.             else
  659.                filearg(argc,argv,i,1,stdout,"w");
  660.             break;
  661.          default:            /* not recognized, go on to next arg */
  662.             i++;
  663.       }
  664.    }
  665.    if (nfargs >= 1 && *argc > 1)    /* if positional redirection & 1 arg */
  666.       filearg(argc,argv,1,0,stdin,"r");    /* then redirect stdin */
  667.    if (nfargs >= 2 && *argc > 1)    /* likewise for 2nd arg if wanted */
  668.       filearg(argc,argv,1,0,stdout,"w");/* redirect stdout */
  669. }
  670.  
  671.  
  672.  
  673. /* filearg(&argc,argv,n,i,fp,mode) - redirect and remove file argument
  674.  *    int *argc        number of command arguments (from call to main)
  675.  *    char *argv[]    command argument list (from call to main)
  676.  *    int n        argv entry to use as file name and then delete
  677.  *    int i        first character of file name to use (skip '<' etc.)
  678.  *    FILE *fp        file pointer for file to reopen (typically stdin etc.)
  679.  *    char mode[]    file access mode (see freopen spec)
  680.  */
  681.  
  682. filearg(argc,argv,n,i,fp,mode)
  683. int *argc, n, i;
  684. char *argv[], mode[];
  685. FILE *fp;
  686. {
  687.    if (strcmp(argv[n]+i,"-"))        /* alter file if arg not "-" */
  688.       fp = freopen(argv[n]+i,mode,fp);
  689.    if (fp == NULL)  {            /* abort on error */
  690.       fprintf(stderr,"%%can't open %s",argv[n]+i);
  691.       exit(ErrorExit);
  692.    }
  693.    for ( ;  n < *argc;  n++)        /* move down following arguments */
  694.       argv[n] = argv[n+1];
  695.    *argc = *argc - 1;            /* decrement argument count */
  696. }
  697.  
  698. /* Special versions of sbrk() and brk() for use by Icon under VMS.
  699.  * #defines in define.h actually rename these to vms_brk and vms_sbrk.
  700.  *
  701.  * For historical reasons, Icon assumes it can repeatedly call brk/sbrk
  702.  * and always get contiguous chunks.  This was made to work under Unix by
  703.  * overloading the definitions of malloc and friends, the only other callers
  704.  * of sbrk, and making them return Icon-managed memory.
  705.  
  706.  * Under VMS, sbrk is not the lowest-level system interface.  It gets memory
  707.  * from underlying VMS routines such as SYS$EXPREG.  These routines are also
  708.  * called by others, for example when a file is opened;  so successive sbrk
  709.  * calls may return nonadjacent chunks.  This makes overloading malloc and
  710.  * friends futile.
  711.  *
  712.  * The routines below replace sbrk and brk for Icon (only) under VMS.  They
  713.  * provide the continuously growing memory Icon needs without relying on
  714.  * special privileges or unusually large quotas.  Like the Unix solution and
  715.  * earlier VMS attempts, this is an empirical solution and may need further
  716.  * revision as the system changes.  But we hope not.
  717.  *
  718.  * The Icon interpreter is loaded beginning at address 0 and grows upward as
  719.  * it requests more memory through sbrk.  The C stack grows downward from
  720.  * 0x7FFFFFFF. We're going to draw a line to divide the address space, then
  721.  * force the C and VMS runtime systems to put anything they need above it;
  722.  * then sbrk can grow the program region unimpeded up to the line.
  723.  *
  724.  * The line is drawn MAXMEM bytes beyond the start of the sbrk region.  MAXMEM
  725.  * is an environment variable (logical name to VMS) with a default as given in
  726.  * define.h.  Large values cost CPU and real time expended at process exit; we
  727.  * don't know why.  On an 8600 the cost was very roughly .04 CP sec / megabyte.
  728.  *
  729.  * When first called, sbrk expands the program region by one page to get a
  730.  * starting address.  A limit address is calculated by adding MAXMEM.  A single
  731.  * page created just below the limit address "draws the line" and causes the
  732.  * VMS runtime system to allocate anything it needs above that point.  sbrk
  733.  * creates pages between base and limit as needed.
  734.  *
  735.  * Possible errors and their manifestations:
  736.  *
  737.  *    MAXMEM too large to initialize sbrk:
  738.  *       error in startup code: value of MAXMEM too large
  739.  *
  740.  *    MAXMEM too small to initialize sbrk:
  741.  *       error in startup code: value of MAXMEM too small
  742.  *
  743.  *    MAXMEM too small for subsequent brk/sbrk growth
  744.  *       Run-time error 351:  insufficient MAXMEM limit
  745.  *
  746.  *    MAXMEM okay but insufficient user quota for needed memory:
  747.  *       Run-time error 303:  unable to expand memory region
  748.  *
  749.  *    unexpected ("can't happen") failures of system calls:
  750.  *       these produce their standard VMS error message
  751.  *
  752.  *    unexpected intrusion into the sbrk region by the runtime system:
  753.  *       unknown, but undoubtedly ugly
  754.  */
  755.  
  756.  
  757. #define PageSize 512        /* size of a VMS page */
  758. #define MaxP0 0x40000000    /* first address beyond the P0 region */
  759.  
  760. #include <stsdef.h>
  761.  
  762. word memsize = MaxMem;        /* set from environment variable MAXMEM */
  763.  
  764.  
  765. /*  sbrk(incr) - adjust the break value by incr, rounding up to a page.
  766.  *  returns the new break value, or -1 if unsuccessful.
  767.  */
  768.  
  769. char *
  770. sbrk(incr)
  771. int incr;
  772. {
  773.    static char *base;        /* base of the sbrk region */
  774.    static char *curr;        /* current break value (end+1) */
  775.    static char *limit;        /* region limit ("the line") */
  776.    char *range[2], *p;        /* scratch for system calls */
  777.    int s;            /* status return from calls */
  778.  
  779.    /*  initialization code */
  780.    if (!base)  {
  781.       s = sys$expreg(1,range,0,0);    /* expand P0 to get base address */
  782.       if (!(s & STS$M_SUCCESS))
  783.          exit(s);            /* couldn't get one page?! */
  784.       base = curr = range[0];        /* initialize empty sbrk region */
  785.       memsize = (memsize + PageSize - 1) & -PageSize;
  786.                     /* round memsize to page boundary */
  787.       limit = base + memsize;        /* calculate sbrk region limit*/
  788.       if (limit > MaxP0)
  789.      limit = MaxP0;            /* limit to legal values */
  790.       if (limit <= base)
  791.          error("value of MAXMEM too small");  /* can't even start */
  792.       range[0] = range[1] = limit-1;
  793.       s = sys$cretva(range,range,0);    /* get a page there to draw the line */
  794.       if (!(s & STS$M_SUCCESS))
  795.          error("value of MAXMEM too large");  /* can't even start */
  796.    }
  797.  
  798.    if (incr > 0)  {
  799.  
  800.       /* grow the region */
  801.       if (curr + incr > limit)        /* check address space available */
  802.          fatalerr(-351,NULL);        /* oops, MAXMEM too small */
  803.       range[0] = curr;
  804.       range[1] = curr + incr - 1;
  805.       s = sys$cretva(range,range,0);    /* ask for the pages */
  806.       if (!(s & STS$M_SUCCESS))
  807.          return (char *) -1;        /* failed, quota exceeded */
  808.       curr = range[1] + 1;        /* set new break value as returned */
  809.  
  810.    } else if (incr < 0) {
  811.  
  812.       /* shrink the region (not expected to be used).  does not actually
  813.        * return the memory, but does make it available for reuse.  */
  814.       curr -= -incr & -PageSize;
  815.    }
  816.  
  817.    /* return the current break value */
  818.    return curr;
  819. }
  820.  
  821.  
  822.  
  823.  
  824. /*  brk(addr) - set the break address to the given value, rounded up to a page.
  825.  *  returns 0 if successful, -1 if not.
  826.  */
  827.  
  828. char *
  829. brk(addr)
  830. char *addr;
  831. {
  832.    return ((sbrk(addr-sbrk(0))) == (char *) -1 ? (char *) -1 : 0);
  833. }
  834. #endif                    /* VMS */
  835.  
  836. /*
  837.  * End of operating-system specific code.
  838.  */
  839.  
  840. static char x;            /* avoid empty module */
  841.